home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / bbsutil / dlx70bbs.zip / DLX70SRC.ZIP / FS_PKG.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-19  |  6KB  |  224 lines
  1. {$debug-}
  2. {$line-}
  3.  
  4. {$include: 'types.int'}
  5. {$include: 'globals.int'}
  6. {$include: 'utils.int'}
  7. {$include: 'fs_pkg.int'}
  8.  
  9. IMPLEMENTATION OF fs_pkg;
  10.  
  11. USES types,globals,utils;
  12.  
  13. {DLX Bulletin Board System V7.0
  14.  
  15.  FREEWARE NOTICE
  16.  
  17.  DLX V7.0 is placed in the public domain by its author, Richard Gillmann.
  18.  Anyone who wishes to may run the program, copy it, or modify it for
  19.  any purpose, including commercial gain.}
  20.  
  21. {***Interface to the PASASM assembler utilities package***}
  22. {$include: 'pasasm.int'}
  23.  
  24. const
  25.   cr = chr(13);                {carriage return}
  26.   lf = chr(10);                {linefeed}
  27.   ctrlz = chr(26);            {old style eof}
  28.   ioblen = 256;                {i/o buffer length in bytes}
  29.  
  30. type
  31.   text_file = record
  32.     buffer : array [1..ioblen] of char;    {readln info}
  33.     ngood : integer;            {number of good chars in buffer}
  34.     bptr : integer;            {buffer subscript of next char}
  35.     fptr : integer4;            {dos file pointer (1 origin)}
  36.   end {text_file};
  37.  
  38. var
  39.   f : ads of array [0..number_of_lines] of text_file;
  40.   crlf : lstring(2);
  41.  
  42. value
  43.   crlf:=cr*lf;
  44.  
  45. {initialize this file package}
  46. procedure fs_init;
  47. begin
  48.   f := far_alloc(sizeof(f^));
  49. end {fs_init};
  50.  
  51. {open a text file for reading; return 0 or dos error code}
  52. function fs_openr{line : integer; consts s : lstring} {integer};
  53. var
  54.   i,n : integer;
  55. label out;
  56. begin
  57.   if line<0 or else line>number_of_lines then
  58.     [fs_openr:=4; return];
  59.   f^[line].ngood:=0;
  60.   f^[line].bptr:=ioblen+1;
  61.   f^[line].fptr:=1;
  62.   q[line].handle:=0;
  63.   q[line].dos_err:=0;
  64.   for i:=0 to number_of_lines do
  65.     if i<>line and then w^[i].file_locked<>nill and then
  66.        eq(s,w^[i].file_locked^.msg) and then w^[i].rw=writing then
  67.       [q[line].dos_err:=-1; goto out];
  68.   n:=xopen(0,s);
  69.   if n<0 then
  70.     [q[line].dos_err:=-n; goto out];
  71.   q[line].handle:=n;
  72.   if w^[line].file_locked=nill
  73.     then w^[line].file_locked:=newpara(s)
  74.     else kopylst(s,w^[line].file_locked^.msg);
  75.   w^[line].rw:=reading;
  76. out:
  77.   fs_openr:=q[line].dos_err;
  78. end {fs_openr};
  79.  
  80. {open a text file for writing; return 0 or dos error code}
  81. function fs_openw{line : integer; consts s : lstring} {integer};
  82. var
  83.   i,n : integer;
  84. label out;
  85. begin
  86.   if line<0 or else line>number_of_lines then
  87.     [fs_openw:=4; return];
  88.   f^[line].ngood:=-1;
  89.   f^[line].bptr:=1;
  90.   f^[line].fptr:=1;
  91.   q[line].handle:=0;
  92.   q[line].dos_err:=0;
  93.   for i:=0 to number_of_lines do
  94.     if i<>line and then w^[i].file_locked<>nill and then
  95.        eq(s,w^[i].file_locked^.msg) then
  96.       [q[line].dos_err:=-1; goto out];
  97.   n:=xopen(1,s);
  98.   if n<0 then
  99.     [q[line].dos_err:=-n; goto out];
  100.   q[line].handle:=n;
  101.   if w^[line].file_locked=nill
  102.     then w^[line].file_locked:=newpara(s)
  103.     else kopylst(s,w^[line].file_locked^.msg);
  104.   w^[line].rw:=writing;
  105. out:
  106.   fs_openw:=q[line].dos_err;
  107. end {fs_openw};
  108.  
  109. {have we reached end of file while reading?}
  110. function fs_eof{line : integer} {boolean};
  111. var
  112.   n : integer;
  113. begin
  114.   fs_eof:=true;
  115.   if line<0 or else line>number_of_lines or else q[line].dos_err<>0 then
  116.     return;
  117.   if f^[line].bptr>ioblen then begin
  118.     n:=xread(q[line].handle,ads f^[line].buffer,ioblen);
  119.     if n>=0 then
  120.       [f^[line].ngood:=n;
  121.        f^[line].fptr:=f^[line].fptr+n;
  122.        f^[line].bptr:=1;
  123.        q[line].dos_err:=0]
  124.     else
  125.       [f^[line].ngood:=0;
  126.        f^[line].bptr:=1;
  127.        q[line].dos_err:=-n];
  128.   end {if};
  129.   if f^[line].bptr>f^[line].ngood or else
  130.      f^[line].buffer[f^[line].bptr]=ctrlz then
  131.     return;
  132.   fs_eof:=false;
  133. end {fs_eof};
  134.  
  135. {get the next line from a text file}
  136. function fs_gets{line : integer; vars s : lstring} {integer};
  137. var
  138.   i,n : integer;
  139.   ch : char;
  140. begin
  141.   s.len:=0;
  142.   if line<0 or else line>number_of_lines then
  143.     [fs_gets:=4; return];
  144.   i:=0;
  145.   while true do begin
  146.     if f^[line].bptr>ioblen then begin
  147.       n:=xread(q[line].handle,ads f^[line].buffer,ioblen);
  148.       if n>=0 then
  149.     [f^[line].ngood:=n;
  150.      f^[line].fptr:=f^[line].fptr+n;
  151.      f^[line].bptr:=1;
  152.      q[line].dos_err:=0]
  153.       else
  154.     [f^[line].ngood:=0;
  155.      f^[line].bptr:=1;
  156.      q[line].dos_err:=-n;
  157.      break];
  158.     end {if};
  159.     if f^[line].bptr>f^[line].ngood then break; {missing crlf at eof}
  160.     ch:=f^[line].buffer[f^[line].bptr];
  161.     f^[line].bptr:=f^[line].bptr+1;
  162.     if ch=cr then cycle;
  163.     if ch=lf then break;
  164.     if i<UPPER(s) then
  165.       [i:=i+1; s[i]:=ch; s.len:=wrd(i)];
  166.   end {while};
  167.   fs_gets:=q[line].dos_err;
  168. end {fs_gets};
  169.  
  170. function fs_puts{line : integer; consts s : lstring} {integer};
  171. var
  172.   i,n : integer;
  173.   ch : char;
  174. begin
  175.   if line<0 or else line>number_of_lines then
  176.     [fs_puts:=4; return];
  177.   f^[line].ngood:=-1;            {we're writing}
  178.   i:=1;
  179.   while i<=ord(s.len)+2 do begin
  180.     if f^[line].bptr>ioblen then begin
  181.       n:=xwrite(q[line].handle,ads f^[line].buffer,ioblen);
  182.       if n>=0 then
  183.     [f^[line].fptr:=f^[line].fptr+n;
  184.      f^[line].bptr:=1;
  185.      q[line].dos_err:=0]
  186.       else
  187.     [q[line].dos_err:=-n;
  188.      break];
  189.     end {if};
  190.     if i<=ord(s.len) then
  191.       ch:=s[i]
  192.     else if i=ord(s.len)+1 then
  193.       ch:=cr
  194.     else
  195.       ch:=lf;
  196.     f^[line].buffer[f^[line].bptr]:=ch;
  197.     f^[line].bptr:=f^[line].bptr+1;
  198.     i:=i+1;
  199.   end {while};
  200.   fs_puts:=q[line].dos_err;
  201. end {fs_puts};
  202.  
  203. procedure fs_close{line : integer};
  204. var
  205.   n : integer;
  206. begin
  207.   if line<0 or else line>number_of_lines then return;
  208.   if f^[line].ngood=-1 and then f^[line].bptr>1 then begin
  209.     n:=xwrite(q[line].handle,ads f^[line].buffer,wrd(f^[line].bptr-1));
  210.     if n>=0 then 
  211.       [f^[line].fptr:=f^[line].fptr+n;
  212.        f^[line].bptr:=1;
  213.        q[line].dos_err:=0]
  214.     else
  215.       q[line].dos_err:=-n;
  216.   end {if};
  217.   if q[line].handle>0 then
  218.     mail_close(q[line].handle);
  219.   q[line].handle := 0;
  220.   if w^[line].file_locked<>nill then w^[line].file_locked^.msg:=null;
  221. end {fs_close};
  222.  
  223. END.
  224.